open Ast
open Bytecode

(* Stack layout just after "Ent":

              <-- SP
   Local n
   ...
   Local 0
   Saved HC
   Saved FP   <-- FP
   Saved PC
   Arg 0
   ...
   Arg n *)
   
 (** !!!!!!!!   WORKING BLOCK    !!!!!!!!!  *) 
 (* Removed code: 
 ignore (gc (new_sp+1) (sp+1) new_hc); 
  
 (*collect garbage when a funct returns *)  	
in let gc fp sp hc = 
	Array.fill heap fp (hc-fp) "";
  	Array.fill stack fp (sp-fp) 0
  	  
 *)

let execute_prog prog d =
  let stack = Array.make 1024 0
  and heap = Array.make 1024 "" in
 
(** maintenance tools *)
(* print debug statements *)
let debug fp sp pc hc = 
   	print_string "stack = "; Array.iteri (fun index value -> 
  		if (index < sp) then print_string 
  			(string_of_int index ^ ":" ^ string_of_int value ^ " ")) stack; 
  	print_string "\nheap = "; Array.iteri (fun index value -> 
  		if (index < hc) then print_string 
  			(string_of_int index ^ ":" ^ value ^ " ")) heap;
 	print_endline "\n----------------------";
 	print_endline ((string_of_int pc) ^ ": " ^ 
 		Bytecode.string_of_stmt prog.text.(pc) ^
 		" (fp:" ^  (string_of_int fp) ^ 
 		"; sp:" ^ (string_of_int sp) ^
 		"; hc:" ^ (string_of_int hc) ^ ") -->")
  	
(** execution helper functions *)

(* add string to heap; return a heap pointer to that string *)
in let set_S hc str = 
	heap.(hc) <- str; hc
(* get an int pointer to the string on the heap *)
in let get_S key = if key = -1 then ""
	else heap.(key)

	
(* allocate a new array on the heap *)	
in let new_A hc l f = 
	let t = (l>0) in match (t,f) with 
	(* array with pointers to its strings immediately before it on heap *) 
	(true, 1) -> let rec a = function
			0 -> ""
			| len -> (string_of_int (hc-len)) ^ ";" ^ (a (len-1))
			in set_S hc (a l)
	(* alloc an array of size l with null pointers *)
	|(true, 0) -> let rec a = function
			0 -> ""
			| len -> (string_of_int (-1)) ^ ";" ^ (a (len-1))
			in set_S hc (a l)
	(* empty array pointer *)
	|(false, 0) -> set_S hc ""
	| _ -> hc
(* save an array's string on the heap *)
in let set_A_ref hc a = 
	set_S hc (String.concat ";" (List.map string_of_int (Array.to_list a))) 	
(* returns int list with pointers to strings on heap *)
(* string Array -> int -> int list *)
in let get_A_ref key = 
	let a_ref_strList = Str.split (Str.regexp ";") heap.(key) in
	List.map int_of_string a_ref_strList
(* list of pointer ints -> list of actual strings *)	
in let get_A key = 
	let a = get_A_ref key
	and value k = match k with -1 -> "" | _ -> (heap.(k)) in
	List.map value a
	
(* set int values for bools *)
in let boolean i = if i then 1 else 0
in let booli i = if (i=1) then true else false
in let nbooli i = if (i=0) then true else false

(** enter program execution *)
in let rec exec fp sp pc hc = 
  if (d = 1) then debug fp sp pc hc ;
  match prog.text.(pc) with
    Int i  -> stack.(sp) <- i ; exec fp (sp+1) (pc+1) hc
  (* add a string to the heap *)
  | Str s	 -> stack.(sp) <- set_S hc s; exec fp (sp+1) (pc+1) (hc+1) 
  (* add an array ref indicating length to the heap *)
  | Arr (l, f)  -> stack.(sp) <- new_A hc l f; exec fp (sp+1) (pc+1) (hc+1) 
  | Drp    -> exec fp (sp-1) (pc+1) hc (* Discard a value *)
  | Opr (op, typ, args) -> (match (typ, args) with
 	(* Rng of string *)
  	(Ast.Str,3) ->  let b = stack.(sp-2) and n = stack.(sp-1)
	  				and s = get_S stack.(sp-3) in
			  		let f = (Str.string_after (Str.string_before s (n+1)) b) in
			  		stack.(sp-3) <- set_S hc f; exec fp (sp-2) (pc+1) (hc+1)	
  	|(Ast.Arr,3) -> (match op with 
  		Sai		-> let e = stack.(sp-3) and i = stack.(sp-2)
			  		and a = Array.of_list (get_A_ref stack.(sp-1)) in (* yields int array *)
			  		stack.(sp-3) <- set_S a.(i) (get_S e); exec fp (sp-2) (pc+1) (hc+1)
  		| Rng  	-> let b = stack.(sp-2) and n = stack.(sp-1)
		  			and a = get_A_ref stack.(sp-3) in
		  			let f = Array.sub (Array.of_list a) b (n-b+1) in
		  			stack.(sp-3) <- set_A_ref hc f; exec fp (sp-2) (pc+1) (hc+1)
		  |_		 -> exec fp sp (pc+1) hc)
  	(* binops for stack arithmetic/boolean eval of ints *)
  	|(Ast.Int,2) -> let op1 = stack.(sp-2) and op2 = stack.(sp-1) in     
      	stack.(sp-2) <- (match op with
  		Add     	-> op1 + op2
      	| Sub     -> op1 - op2
      	| Eq   	-> boolean (op1 = op2)
      	| Neq     -> boolean (op1 != op2)
      	| Lt    	-> boolean (op1 < op2)
      	| Leq     -> boolean (op1 <= op2)
      	| Gt 	-> boolean (op1 > op2)
      	| Geq     -> boolean (op1 >= op2)
      	| And	-> boolean ((booli(op1) && booli(op2)))
      	| Or		-> boolean ((booli(op1) || booli(op2))));
      	exec fp (sp-1) (pc+1) hc   	
	|(Ast.Str,2) -> let op1 = get_S(stack.(sp-2)) in (match op with
	     Vat		-> let op2 = stack.(sp-1) in
			stack.(sp-2) <- set_S hc (String.make 1 op1.[op2]); exec fp (sp-1) (pc+1) (hc+1)
      	| Add	-> let op2 = get_S(stack.(sp-1)) in
      		stack.(sp-2) <- set_S hc (op1 ^ op2); exec fp (sp-1) (pc+1) (hc+1)
      	| Eq   	-> let op2 = get_S stack.(sp-1) in
      		stack.(sp-2) <- boolean (nbooli(String.compare op1 op2)); exec fp (sp-1) (pc+1) (hc)
      	| Neq     -> let op2 = get_S stack.(sp-1) in
      		stack.(sp-2) <- boolean (not(nbooli(String.compare op1 op2))); exec fp (sp-1) (pc+1) (hc))
	|(Ast.Any,2) -> let msg = get_S stack.(sp-1) in print_endline msg; exec fp (sp) (pc+1) (hc)			     
	|(Ast.Arr,2) -> (match op with
		Vat	 -> let i = stack.(sp-2) and a = Array.of_list (get_A_ref stack.(sp-1)) in
			  	stack.(sp-2) <- a.(i); exec fp (sp-1) (pc+1) (hc)
      	| Add -> let a1 = (get_A_ref stack.(sp-2)) and a2 = (get_A_ref stack.(sp-1)) in
			  	stack.(sp-2) <- set_A_ref hc (Array.of_list(a1 @ a2)); exec fp (sp-1) (pc+1) (hc+1)
      	| Eq  -> let a1 = (get_A stack.(sp-2)) and a2 = (get_A stack.(sp-1)) in
			  	stack.(sp-2) <- boolean(a1 = a2); exec fp (sp-1) (pc+1) (hc)
      	| Neq -> let a1 = (get_A stack.(sp-2)) and a2 = (get_A stack.(sp-1)) in
			  	stack.(sp-2) <- boolean(a1 <> a2); exec fp (sp-1) (pc+1) (hc))		
	|(Ast.Int ,1) -> let op1 = stack.(sp-1) in (match op with
		Not	 -> stack.(sp-1) <- boolean(nbooli(op1)); 
		exec fp (sp) (pc+1) (hc))
	|(Ast.Str ,1) -> let op1 = get_S stack.(sp-1) in	(match op with	
(** TBD  	In  -> let input = "1"  in
  		stack.(sp-1) <- set_S hc input; exec fp (sp-1) (pc+1) (hc+1)
  		let filename = "test" in if Sys.file_exists then 
  		else raise(Failure "Input file (" ^ filename ^ ") not found")  *)
  		
  		| Len -> stack.(sp-1) <- String.length op1; exec fp (sp) (pc+1) (hc))
	|(Ast.Arr ,1) -> (match op with
  		| Len -> stack.(sp-1) <- List.length (get_A_ref stack.(sp-1)); exec fp (sp-1) (pc+1) (hc)))
  		  
  | Lod i   -> stack.(sp)   <- stack.(fp+i) ; exec fp (sp+1) (pc+1) hc
  | Sto i   -> stack.(fp+i) <- stack.(sp-1) ; exec fp sp (pc+1) hc 
  | Jsr i   -> stack.(sp)   <- pc + 1       ; exec fp (sp+1) i hc 
  | Ent i   -> stack.(sp)   <- fp; stack.(sp+1) <-hc; exec (sp+1) (sp+i+2) (pc+1) hc 
  | Ret i   -> let new_fp = stack.(fp) and new_sp = stack.(fp-i-1) 
  			and new_pc = stack.(fp-1) and new_hc = stack.(fp+1) in
  			stack.(fp-i) <- stack.(sp-1) ;
  			exec new_fp new_sp new_pc new_hc  			
  | Beq i   -> exec fp (sp-1) (pc + if stack.(sp-1) =  0 then i else 1) hc 
  | Bne i   -> exec fp (sp-1) (pc + if stack.(sp-1) != 0 then i else 1) hc
  | Bra i   -> exec fp sp (pc+i) hc  
  | Hlt     -> ()

  in exec 0 0 0 0
